home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Original Shareware 1.1
/
The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso
/
32
/
pocket.zip
/
PHONE.BAS
< prev
Wrap
BASIC Source File
|
1986-12-08
|
9KB
|
235 lines
1000 '
1010 ' '
1020 ' TYPE "BASIC PHONE" TO RUN THIS PROGRAM ON AN IBM-PC.
1030 ' '
1040 ' PHONE COPYRIGHT (C) 1985, 1986 TURING & BABBAGE.
1050 ' '
1060 ' PERMISSION IS GRANTED TO REPRODUCE THIS PROGRAM, CIRCULATE IT WITHOUT
1070 ' CHARGE, AND USE IT FOR EVALUATION PURPOSES ONLY. REGULAR USE
1080 ' REQUIRES ROYALTY PAYMENT OF $20 TO TURING & BABBAGE, P.O. BOX 785,
1090 ' BROOKLINE, MA 02146 USA. YOU MAY MODIFY AND CIRCULATE THIS PROGRAM
1100 ' PROVIDED YOU DO NOT REMOVE OR CHANGE THIS OR ANY OTHER MESSAGE.
1110 ' PLEASE SEND YOUR NEW CODE, COMMENTS OR SUGGESTIONS TO TURING &
1120 ' BABBAGE OR TO COMPUSERV USER ID [72007,147]. THANK YOU.
1130 ' '
1140 '
1150 'START:
1160 GOSUB 3110
1170 GOSUB 1290
1180 GOSUB 1230
1190 GOSUB 1530
1200 GOSUB 2090
1210 GOSUB 2680
1220 SYSTEM
1230 'SETTINGS:
1240 'CALC SIZE FROM PRINTER SELECTION
1250 PGX=INT(PGXIN*CHRPERIN)-EDGEMAR-SPINEMAR : PGY=INT(PGYIN*LINPERIN)-YMAR*2-1
1260 DIM PG$(PGY)
1270 PGCNT=0
1280 RETURN 'SETTINGS
1290 'USER.INPUT:
1300 PRINT "Turing & Babbage PHONE V2.0 (C) 1985, 1986"
1310 LINE INPUT "TYPE YOUR PHONE BOOK FILE NAME (ENTER FOR HELP): ";FILEIN$
1320 IF FILEIN$="" THEN GOSUB 2850 : GOTO 1290
1330 GOSUB 1360
1340 GOSUB 1410
1350 RETURN 'USER.INPUT
1360 'USER.INPUT.DEVICE:
1370 PRINT "PRESS ENTER NOW TO SEND OUTPUT TO YOUR PRINTER, OR ENTER A FILENAME: ";
1380 LINE INPUT PRDEV$
1390 IF PRDEV$="" THEN PRDEV$="LPT1:"
1400 RETURN 'USER.INPUT.DEVICE
1410 'USER.INPUT.PRINTER:
1420 PRINT "SELECT A PRINTER"
1430 FOR I=1 TO PRCOUNT
1440 PRINT USING "####. ";I; : PRINT PRNAM$(I)
1450 NEXT
1460 'USER.INPUT.PRINTER.2:
1470 LINE INPUT "ENTER PRINTER NUMBER: ";A$ : A=INT(VAL(A$))
1480 IF A<1 OR A>PRCOUNT THEN GOTO 1460
1490 PRNAM$=PRNAM$(A) : PRINIT$=PRINIT$(A) : PGXIN=PGXIN(A) : PGYIN=PGYIN(A)
1500 CHRPERIN=CHRPERIN(A) : LINPERIN=LINPERIN(A)
1510 EDGEMAR=EDGEMAR(A) : SPINEMAR=SPINEMAR(A) : YMAR=YMAR(A)
1520 RETURN 'USER.INPUT.PRINTER
1530 'PASS.1:
1540 OPEN FILEIN$ FOR INPUT AS #1
1550 OPEN "PHONE.TMP" FOR OUTPUT AS #2
1560 OPEN "PHONE.ERR" FOR OUTPUT AS #3
1570 GOSUB 1960
1580 'S.2000:
1590 FOR E=1 TO PGY
1600 'S.2005:
1610 IF EOF(1) THEN GOTO 1720
1620 IF B$="" THEN LINE INPUT #1,A$ ELSE A$=",,"+B$
1630 B$="" : B=INSTR(A$,",,") : IF B THEN B$=MID$(A$,B+2) : A$=LEFT$(A$,B-1)
1640 IF LEFT$(A$,2)="@R" THEN A$="" : B$="" : GOTO 1600
1650 IF LEFT$(A$,2)="@S" THEN IF VAL(MID$(A$,3))+E-1<=PGY THEN GOTO 1600 ELSE E=PGY : GOTO 1700
1660 IF LEN(A$)>PGX THEN GOSUB 1770
1670 IF LEN(B$)>PGX-1 THEN GOSUB 1820
1680 B=PGX-LEN(A$)-LEN(B$) 'SPACE REMAINING ON LINE
1690 IF B>=0 THEN GOSUB 1870 ELSE GOSUB 1900
1700 'S.2120:
1710 NEXT
1720 'S.3000:
1730 GOSUB 2000 : GOSUB 1960
1740 IF NOT EOF(1) GOTO 1580
1750 CLOSE #1 : CLOSE #2 : CLOSE #3
1760 RETURN 'PASS.1
1770 'TRUNCATE.A:
1780 PRINT #3,"Truncated: ";A$
1790 PRINT "This is too long and was truncated as shown:"
1800 PRINT " ";A$ : A$=LEFT$(A$,PGX) : PRINT " ";A$
1810 RETURN
1820 'TRUNCATE.B:
1830 PRINT #3,"Truncated: ";B$
1840 PRINT "This is too long and was truncated as shown:"
1850 PRINT " ";B$ : B$=LEFT$(B$,PGX-1) : PRINT " ";B$
1860 RETURN
1870 'JOIN.LINE:
1880 PG$(E)=A$+STRING$(B,32)+B$ : B$=""
1890 RETURN
1900 'SPLIT.LINE:
1910 PG$(E)=A$+STRING$(PGX-LEN(A$),32)
1920 PRINT "This line too long. It will be split into two lines."
1930 PRINT " ";A$;",,";B$
1940 PRINT #3,"Split: ";A$;",,";B$
1950 RETURN
1960 'S.5000:
1970 ' CLR PG$()
1980 FOR II=1 TO PGY : PG$(II)=STRING$(PGX,32) : NEXT
1990 RETURN
2000 'PRINT.PAGE:
2010 ' PRINT A PAGE
2020 FOR I=1 TO PGY
2030 PRINT #2,PG$(I)
2040 NEXT
2050 PGCNT=PGCNT+1
2060 PRINT #2,CHR$(12)
2070 PRINT "Finished preparing page";PGCNT;CHR$(13);
2080 RETURN 'PRINT.PAGE
2090 'PASS.2:
2100 OPEN "PHONE.TMP" FOR INPUT AS #1
2110 OPEN PRDEV$ FOR OUTPUT AS #2
2120 IF PRDEV$="LPT1:" THEN WIDTH #2,255
2130 PRINT #2,PRINIT$;
2140 ' INIT PAGE COUNTERS
2150 TOPDN=1 : BOTUP=PGCNT
2160 IF (BOTUP/2)<>INT(BOTUP/2) THEN BOTUP=BOTUP+1
2170 LASTPG=BOTUP/2
2180 'S.7300:
2190 ' LOOP TO PRINT SHEETS
2200 SHEET=.5+(BOTUP-TOPDN)/2
2210 PRINT "Printing sheet";SHEET;"for pages";TOPDN;"and";BOTUP
2220 PRINT #2,"This is sheet";SHEET : PRINT #2,""
2230 OPEN "PHONE.TMP" FOR INPUT AS #3 : I=1
2240 ' FIND BOTUP PAGE
2250 WHILE NOT EOF(3) AND I<BOTUP
2260 'S.7340:
2270 LINE INPUT #3,A$ : IF A$<>CHR$(12) THEN GOTO 2260
2280 I=I+1
2290 WEND
2300 ' SEND THE SHEET
2310 PRINT #2," ";"+";
2320 FOR I=1 TO 1+PGX*2+EDGEMAR*2+SPINEMAR*2 : PRINT #2,"-"; : NEXT
2330 PRINT #2,"+"
2340 GOSUB 2620
2350 FOR LNCT=1 TO PGY ' FOR EACH LINE IN SHEET
2360 PRINT #2," |";
2370 FOR I=1 TO EDGEMAR : PRINT #2," "; : NEXT
2380 A$=STRING$(PGX,32)
2390 IF NOT EOF(1) THEN LINE INPUT #1,A$
2400 PRINT #2,A$;
2410 FOR I=1 TO SPINEMAR : PRINT #2," "; : NEXT
2420 PRINT #2,"|";
2430 FOR I=1 TO SPINEMAR : PRINT #2," "; : NEXT
2440 A$=STRING$(PGX,32)
2450 IF NOT EOF(3) THEN LINE INPUT #3,A$
2460 PRINT #2,A$;
2470 FOR I=1 TO EDGEMAR : PRINT #2," "; : NEXT
2480 PRINT #2,"|"
2490 NEXT ' LINE IN SHEET
2500 LINE INPUT #1,A$ 'EAT ^L LINE
2510 CLOSE #3 ' END OF SHEET
2520 GOSUB 2620
2530 PRINT #2," ";"+";
2540 FOR I=1 TO 1+PGX*2+EDGEMAR*2+SPINEMAR*2 : PRINT #2,"-"; : NEXT
2550 PRINT #2,"+";
2560 PRINT #2, : PRINT #2,CHR$(12);
2570 BOTUP=BOTUP-1 : TOPDN=TOPDN+1
2580 ' LOOP TO PRINT NEXT SHEET
2590 IF TOPDN<=LASTPG GOTO 2180
2600 CLOSE #1 : CLOSE #2
2610 RETURN 'PASS.2
2620 'YMAR.EMPTY.LINES:
2630 FOR I=1 TO YMAR
2640 PRINT #2," |";STRING$(EDGEMAR+PGX+SPINEMAR,32);"|";
2650 PRINT #2,STRING$(SPINEMAR+PGX+EDGEMAR,32);"|"
2660 NEXT
2670 RETURN 'YMAR.EMPTY.LINES
2680 'CUT.INSTRUCTIONS:
2690 CLS
2700 PRINT "Your telephone book is ready to staple, fold and cut as below."
2710 PRINT ""
2720 PRINT "1) Stack the sheets in order, Face Up, with Sheet 1 on the top."
2730 PRINT "2) Turn the stack Face Down and staple twice along the center line."
2740 PRINT "3) Cut the top and bottom edges of the book."
2750 PRINT "4) Fold and firmly crease the book along the center line."
2760 PRINT "5) Cut the right edge."
2770 PRINT ""
2780 PRINT "If you use this program, please pay for it."
2790 PRINT "The suggested price is $20, or $25 for a copy of the latest version."
2800 PRINT "Please pass this program along to a friend."
2810 PRINT ""
2820 PRINT "Turing & Babbage, P.O. Box 785, Brookline, Massachusetts 02146 USA"
2830 PRINT
2840 RETURN
2850 'HELP:
2860 CLS
2870 PRINT "This Turing & Babbage program, PHONE, prints a pocket-size telephone"
2880 PRINT "book ready to be stapled and folded. Prepare an ASCII text file with
2890 PRINT "the contents of your phone book, then run this program."
2900 PRINT ""
2910 PRINT "PHONE will set numbers against the right margin of your phone book"
2920 PRINT "if you use ,, in your input file."
2930 PRINT ""
2940 PRINT "Example Input: Printed in your PHONEbook:"
2950 PRINT "Eisenberg, Joel,,415 555 1212 Eisenberg, Joel 415 555 1212"
2960 PRINT ",,Work 800 555 1212 Work 800 555 1212"
2970 PRINT ",,Nantucket,,617 228 0000 Nantucket 617 228 0000"
2980 PRINT ""
2990 PRINT "PHONE is distributed with these files:"
3000 PRINT " PHONE.BAS Phone program source"
3010 PRINT " PHONE.1 An example PHONE file."
3020 PRINT ""
3030 PRINT "If you use this program, please pay for it."
3040 PRINT "Send $20, or $25 for a copy of the latest version."
3050 PRINT "Please pass this program along to a friend."
3060 PRINT ""
3070 PRINT "Turing & Babbage, P.O. Box 785, Brookline, Massachusetts 02146 USA"
3080 LINE INPUT "Press ENTER to continue.";A$
3090 CLS
3100 RETURN 'HELP
3110 'PRINTER.DATA:
3120 'PGXIN, PGYIN DESIRED BOOK SIZE IN INCHES
3130 'CHRPERIN, LINPERIN ARE PRINT SIZE FOR THE PRINTER
3140 'EDGEMAR MARGIN IN CHARACTERS BETWEEN TEXT AND EDGE OF BOOK
3150 'SPINEMAR MARGIN IN CHARACTERS BETWEEN TEXT AND SPINE OF BOOK
3160 'YMAR TOP/BOTTOM MARGIN IN LINES
3170 ESC$=CHR$(27)
3180 I=1
3190 PRNAM$(I)="IBM or Standard Printer (Compressed Print)"
3200 PRINIT$(I)=CHR$(128+15)+ESC$+"0"+ESC$+"U"+CHR$(1)+CHR$(128+12)
3210 PGXIN(I)=3.1 : PGYIN(I)=5.75 : CHRPERIN(I)=16.666 : LINPERIN(I)=8
3220 EDGEMAR(I)=5 : SPINEMAR(I)=4 : YMAR(I)=1
3230 I=2
3240 PRNAM$(I)="HP LaserJet (Compressed Print)"
3250 PRINIT$(I)=ESC$+"E"+ESC$+"&l1O"+ESC$+"(8U"+ESC$+"(s0p16.66h8.5v0s-1b0T"+ESC$+"&l5.6666C"
3260 PGXIN(I)=3.1 : PGYIN(I)=5.75 : CHRPERIN(I)=16.666 : LINPERIN(I)=8.5
3270 EDGEMAR(I)=5 : SPINEMAR(I)=4 : YMAR(I)=1
3280 I=3
3290 PRNAM$(I)="Standard Printer (Large Print)" : PRINIT$(I)=CHR$(12)
3300 PGXIN(I)=3.5 : PGYIN(I)=5.75 : CHRPERIN(I)=10 : LINPERIN(I)=6
3310 EDGEMAR(I)=1 : SPINEMAR(I)=1 : YMAR(I)=0
3320 PRCOUNT=3 : RETURN 'PRINTER.DATA
3330 '